home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / e33el2.zip / emacs / 19.33 / lisp / lunar.el < prev    next >
Lisp/Scheme  |  1996-02-17  |  17KB  |  392 lines
  1. ;;; lunar.el --- calendar functions for phases of the moon.
  2.  
  3. ;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
  6. ;; Keywords: calendar
  7. ;; Human-Keywords: moon, lunar phases, calendar, diary
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; This collection of functions implements lunar phases for calendar.el and
  29. ;; diary.el.
  30.  
  31. ;; Based on ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus,
  32. ;; Willmann-Bell, Inc., 1985 and ``Astronomical Algorithms'' by Jean Meeus,
  33. ;; Willmann-Bell, Inc., 1991.
  34. ;;
  35. ;; WARNING: The calculations will be accurate only to within a few minutes.
  36.  
  37. ;; The author would be delighted to have an astronomically more sophisticated
  38. ;; person rewrite the code for the lunar calculations in this file!
  39.  
  40. ;; Comments, corrections, and improvements should be sent to
  41. ;;  Edward M. Reingold               Department of Computer Science
  42. ;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
  43. ;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
  44. ;;                                   Urbana, Illinois 61801
  45.  
  46. ;;; Code:
  47.  
  48. (if (fboundp 'atan)
  49.     (require 'lisp-float-type)
  50.   (error "Lunar calculations impossible since floating point is unavailable."))
  51.  
  52. (require 'solar)
  53.  
  54. (defun lunar-phase-list (month year)
  55.   "List of lunar phases for three months starting with Gregorian MONTH, YEAR."
  56.   (let ((end-month month)
  57.         (end-year year)
  58.         (start-month month)
  59.         (start-year year))
  60.     (increment-calendar-month end-month end-year 3)
  61.     (increment-calendar-month start-month start-year -1)
  62.     (let* ((end-date (list (list end-month 1 end-year)))
  63.            (start-date (list (list start-month 
  64.                                    (calendar-last-day-of-month
  65.                                     start-month start-year)
  66.                                    start-year)))
  67.            (index (* 4
  68.                      (truncate
  69.                       (* 12.3685
  70.                          (+ year
  71.                             ( / (calendar-day-number (list month 1 year))
  72.                                 366.0)
  73.                             -1900)))))
  74.            (new-moon (lunar-phase index))
  75.            (list))
  76.       (while (calendar-date-compare new-moon end-date)
  77.         (if (calendar-date-compare start-date new-moon)
  78.             (setq list (append list (list new-moon))))
  79.         (setq index (1+ index))
  80.         (setq new-moon (lunar-phase index)))
  81.       list)))
  82.  
  83. (defun lunar-phase (index)
  84.   "Local date and time of lunar phase INDEX.
  85. Integer below INDEX/4 gives the lunation number, counting from Jan 1, 1900;
  86. remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
  87. 3 last quarter."
  88.   (let* ((phase (mod index 4))
  89.          (index (/ index 4.0))
  90.          (time (/ index 1236.85))
  91.          (date (+ (calendar-absolute-from-gregorian '(1 0.5 1900))
  92.                   0.75933
  93.                   (* 29.53058868 index)
  94.                   (* 0.0001178 time time)
  95.                   (* -0.000000155 time time time)
  96.                   (* 0.00033
  97.                      (solar-sin-degrees (+ 166.56
  98.                                            (* 132.87 time)
  99.                                            (* -0.009173 time time))))))
  100.          (sun-anomaly (mod
  101.                        (+ 359.2242
  102.                           (* 29.105356 index)
  103.                           (* -0.0000333 time time)
  104.                           (* -0.00000347 time time time))
  105.                        360.0))
  106.          (moon-anomaly (mod
  107.                         (+ 306.0253
  108.                            (* 385.81691806 index)
  109.                            (* 0.0107306 time time)
  110.                            (* 0.00001236 time time time))
  111.                         360.0))
  112.          (moon-lat (mod
  113.                     (+ 21.2964
  114.                        (* 390.67050646 index)
  115.                        (* -0.0016528 time time)
  116.                        (* -0.00000239 time time time))
  117.                     360.0))
  118.          (adjustment
  119.           (if (memq phase '(0 2))
  120.               (+ (* (- 0.1734 (* 0.000393 time))
  121.                     (solar-sin-degrees sun-anomaly))
  122.                  (* 0.0021 (solar-sin-degrees (* 2 sun-anomaly)))
  123.                  (* -0.4068 (solar-sin-degrees moon-anomaly))
  124.                  (* 0.0161 (solar-sin-degrees (* 2 moon-anomaly)))
  125.                  (* -0.0004 (solar-sin-degrees (* 3 moon-anomaly)))
  126.                  (* 0.0104 (solar-sin-degrees (* 2 moon-lat)))
  127.                  (* -0.0051 (solar-sin-degrees (+ sun-anomaly moon-anomaly)))
  128.                  (* -0.0074 (solar-sin-degrees (- sun-anomaly moon-anomaly)))
  129.                  (* 0.0004 (solar-sin-degrees (+ (* 2 moon-lat) sun-anomaly)))
  130.                  (* -0.0004 (solar-sin-degrees (- (* 2 moon-lat) sun-anomaly)))
  131.                  (* -0.0006 (solar-sin-degrees
  132.                              (+ (* 2 moon-lat) moon-anomaly)))
  133.                  (* 0.0010 (solar-sin-degrees (- (* 2 moon-lat) moon-anomaly)))
  134.                  (* 0.0005 (solar-sin-degrees
  135.                             (+ (* 2 moon-anomaly) sun-anomaly))))
  136.             (+ (* (- 0.1721 (* 0.0004 time))
  137.                   (solar-sin-degrees sun-anomaly))
  138.                (* 0.0021 (solar-sin-degrees (* 2 sun-anomaly)))
  139.                (* -0.6280 (solar-sin-degrees moon-anomaly))
  140.                (* 0.0089 (solar-sin-degrees (* 2 moon-anomaly)))
  141.                (* -0.0004 (solar-sin-degrees (* 3 moon-anomaly)))
  142.                (* 0.0079 (solar-sin-degrees (* 2 moon-lat)))
  143.                (* -0.0119 (solar-sin-degrees (+ sun-anomaly moon-anomaly)))
  144.                (* -0.0047 (solar-sin-degrees (- sun-anomaly moon-anomaly)))
  145.                (* 0.0003 (solar-sin-degrees (+ (* 2 moon-lat) sun-anomaly)))
  146.                (* -0.0004 (solar-sin-degrees (- (* 2 moon-lat) sun-anomaly)))
  147.                (* -0.0006 (solar-sin-degrees (+ (* 2 moon-lat) moon-anomaly)))
  148.                (* 0.0021 (solar-sin-degrees (- (* 2 moon-lat) moon-anomaly)))
  149.                (* 0.0003 (solar-sin-degrees
  150.                           (+ (* 2 moon-anomaly) sun-anomaly)))
  151.                (* 0.0004 (solar-sin-degrees
  152.                           (- sun-anomaly (* 2 moon-anomaly))))
  153.                (* -0.0003 (solar-sin-degrees
  154.                           (+ (* 2 sun-anomaly) moon-anomaly))))))
  155.          (adj (+ 0.0028
  156.                  (* -0.0004 (solar-cosine-degrees
  157.                              sun-anomaly))
  158.                  (* 0.0003 (solar-cosine-degrees
  159.                             moon-anomaly))))
  160.          (adjustment (cond ((= phase 1) (+ adjustment adj))
  161.                            ((= phase 2) (- adjustment adj))
  162.                            (t adjustment)))
  163.          (date (+ date adjustment))
  164.      (date (+ date (/ (- calendar-time-zone
  165.                  (solar-ephemeris-correction
  166.                               (extract-calendar-year
  167.                                (calendar-gregorian-from-absolute
  168.                                 (truncate date)))))
  169.               60.0 24.0)))
  170.          (time (* 24 (- date (truncate date))))
  171.      (date (calendar-gregorian-from-absolute (truncate date)))
  172.          (adj (dst-adjust-time date time)))
  173.     (list (car adj) (apply 'solar-time-string (cdr adj)) phase)))
  174.  
  175. (defun lunar-phase-name (phase)
  176.   "Name of lunar PHASE.
  177. 0 = new moon, 1 = first quarter, 2 =